library(dplyr)
library(ggpubr)
library(plotly)
library(kableExtra)
library(summarytools)
## Warning: package 'summarytools' was built under R version 4.4.2
library(psych)
## Warning: package 'psych' was built under R version 4.4.2
library(DT)
## Warning: package 'DT' was built under R version 4.4.2
library(modeest)
## Warning: package 'modeest' was built under R version 4.4.2
De acuerdo a los datos de la página mencionada en la tarea, se seleccionó el dataset de una campaña de marketing de un banco, el cual se puede encontrar en el siguiente enlace: https://archive.ics.uci.edu/dataset/222/bank+marketing.
banks_data <- read.csv2("bank-additional-full.csv")
banks_data <- banks_data %>%
mutate(
emp.var.rate = as.numeric(emp.var.rate),
cons.price.idx = as.numeric(cons.price.idx),
cons.conf.idx = as.numeric(cons.conf.idx),
euribor3m = as.numeric(euribor3m),
nr.employed = as.numeric(nr.employed)
)
age <-(banks_data[,1]) # vector con las edades
duration <-(banks_data[,11]) # duración de la ultima llamada en segúndos
campaign <- (banks_data[,12]) # número de contactos realizados durante la campaña para un cliente en específico
pday <- (banks_data[,13]) # vetor con los números de días desde la ultima llamada
previous <- (banks_data[,14]) # número de contactos antes de la campaña
emp.varate.rate <-(banks_data[,16]) # tasa de variación del empleo durante la campaña
cons.price.idx <- (banks_data[,17]) # el mínimo sueldo para vivir
cons.conf.idx <- (banks_data[,18]) # idice de confianza, si estan inviertiendo, ahorrando o solo sobreviviendo
euribor3m <- (banks_data[,19]) # El Euribor a 3 meses es el tipo de interés a la que una selección de bancos europeos se prestan dinero entre sí en euros con vencimientos a 3 meses
nr.employed <- (banks_data[,20]) # números de empleados
cuantitative_banks_data<- data.frame(age, duration, campaign, pday, previous, emp.varate.rate, cons.price.idx, cons.conf.idx, euribor3m, nr.employed)
metricas = describe(cuantitative_banks_data,IQR=T,quant=c(.25,.50,.75)) #Cálculo e métricas
datatable(
metricas,
options = list(pageLength = 10),
caption = "Tabla descriptiva de los datos cuantitativos"
)
tabla_descriptiva <- data.frame("Variables" = c("age", "job", "education", "default", "loan", "contact", "month", "day_of_wek", "duration", "campaign", "pdays", "previous", "poutcome", "emp.var.rate", "cons.price.idx","con.conf.idx","euribor3m", "nr.emplyes", "y"),
"Descripción" = c(
"Edad",
"Tipo de trabajo",
"nivel educativo",
"Si tiene algún credito por pagar",
"Si tiene algún prestamo",
"Tipo de comunicación",
"Mes de la última vez que se contacto",
"Día de la semanda de ultima vez que se contacto",
"duración de la llamada",
"Número de llamadas dentro de la capaña",
"Número de días antes del último contacto",
"Número de contactos realizados antes de la campaña anterior",
"Resultados de la campaña de marketing",
"Tasa de variación del empleo (trimestral)",
"índice de precios al consumidor(indicador mensual)",
"índice de confianza del consumidor(indicador mensual)",
"tasa euribor a 3 meses(indicador diario)",
"Número de empleados(indicador trimestral)",
"Si se subscribio al deposito de plazo"
),
"Tipo de variable" = c(
"cuantitativa",
"cualitativa",
"cualitativa",
"cualitativa",
"cualitativa",
"cualitativa",
"cualitativa",
"cualitativa",
"cuantitativa",
"cuantitativa",
"cuantitativa",
"cuantitativa",
"cualitativa",
"cuantitativa",
"cuantitativa",
"cuantitativa",
"cuantitativa",
"cuantitativa",
"cualitativa"
))
tabla <- kable(tabla_descriptiva ,
caption = "Tabla 1.- Tabla descriptiva ") %>%
kable_styling(full_width = F) %>%
column_spec(1, bold = T, border_right = T)
tabla
| Variables | Descripción | Tipo.de.variable |
|---|---|---|
| age | Edad | cuantitativa |
| job | Tipo de trabajo | cualitativa |
| education | nivel educativo | cualitativa |
| default | Si tiene algún credito por pagar | cualitativa |
| loan | Si tiene algún prestamo | cualitativa |
| contact | Tipo de comunicación | cualitativa |
| month | Mes de la última vez que se contacto | cualitativa |
| day_of_wek | Día de la semanda de ultima vez que se contacto | cualitativa |
| duration | duración de la llamada | cuantitativa |
| campaign | Número de llamadas dentro de la capaña | cuantitativa |
| pdays | Número de días antes del último contacto | cuantitativa |
| previous | Número de contactos realizados antes de la campaña anterior | cuantitativa |
| poutcome | Resultados de la campaña de marketing | cualitativa |
| emp.var.rate | Tasa de variación del empleo (trimestral) | cuantitativa |
| cons.price.idx | índice de precios al consumidor(indicador mensual) | cuantitativa |
| con.conf.idx | índice de confianza del consumidor(indicador mensual) | cuantitativa |
| euribor3m | tasa euribor a 3 meses(indicador diario) | cuantitativa |
| nr.emplyes | Número de empleados(indicador trimestral) | cuantitativa |
| y | Si se subscribio al deposito de plazo | cualitativa |
admin = banks_data[banks_data$job =="admin." & banks_data$y=="yes",]
blue_collar = banks_data[banks_data$job =="blue-collar" & banks_data$y=="yes",]
entrepreneur = banks_data[banks_data$job =="entrepreneur" & banks_data$y=="yes",]
housemaid = banks_data[banks_data$job =="housemaid" & banks_data$y=="yes",]
management = banks_data[banks_data$job =="management" & banks_data$y=="yes",]
retired = banks_data[banks_data$job =="retired" & banks_data$y=="yes",]
self_employed = banks_data[banks_data$job =="self-employed " & banks_data$y=="yes",]
services = banks_data[banks_data$job =="services" & banks_data$y=="yes",]
student = banks_data[banks_data$job =="student" & banks_data$y=="yes",]
technician = banks_data[banks_data$job =="technician" & banks_data$y=="yes",]
unemployed = banks_data[banks_data$job =="unemployed" & banks_data$y=="yes",]
unknow = banks_data[banks_data$job =="unknow" & banks_data$y=="yes",]
admin = nrow(admin)
blue_collar = nrow(blue_collar)
entrepreneur = nrow(entrepreneur)
housemaid = nrow(housemaid)
management = nrow(management)
retired = nrow(retired)
self_employed = nrow(self_employed)
services = nrow(services)
student = nrow(student)
technician = nrow(technician)
unemployed = nrow(unemployed)
unknow = nrow(unknow)
jobs <- c("admin.", "blue-collar", "entrepreneur", "housemaid", "management",
"retired", "self-employed", "services", "student", "technician",
"unemployed", "unknow")
n_employees <- c(admin, blue_collar, entrepreneur, housemaid, management,
retired, self_employed, services, student, technician,
unemployed, unknow)
data_jobs_sus <- data.frame(job = jobs, number_of_yes = n_employees)
fig <- plot_ly(data_jobs_sus, x = ~job, y = ~number_of_yes, type = 'bar',
marker = list(color = 'skyblue'))
fig <- fig %>%
layout(title = "Número de subscripciones aceptadas por profesión",
xaxis = list(title = "Tipo de trabajo", tickangle = -45),
yaxis = list(title = "Número de suscripciones aceptadas"),
margin = list(b = 100)) # Espacio adicional para etiquetas inclinadas
fig
Descripción del grafico 1º
El gráfico anterior muestra la cantidad total de suscripciones aceptadas, categorizadas por profesión. Se observa que las personas con la profesión de administrador son las que más aceptaron esta suscripción de depósito a plazo.
menor_250 = banks_data[banks_data$duration <= 250 & banks_data$y=="yes",] # menor a 250
menor_500 = banks_data[banks_data$duration > 250 & banks_data$duration <= 500 & banks_data$y=="yes",]
menor_750 = banks_data[banks_data$duration > 500 & banks_data$duration <= 750 & banks_data$y=="yes",]
menor_1000 = banks_data[banks_data$duration > 750 & banks_data$duration <= 1000 & banks_data$y == "yes",]
menor_1250 = banks_data[banks_data$duration > 1000 & banks_data$duration <= 1250 & banks_data$y == "yes",]
menor_1500 = banks_data[banks_data$duration > 1250 & banks_data$duration <= 1500 & banks_data$y == "yes",]
menor_1750 = banks_data[banks_data$duration > 1500 & banks_data$duration <= 1750 & banks_data$y == "yes",]
menor_2000 = banks_data[banks_data$duration > 1750 & banks_data$duration <= 2000 & banks_data$y == "yes",]
menor_2250 = banks_data[banks_data$duration > 2000 & banks_data$duration <= 2250 & banks_data$y == "yes",]
menor_2500 = banks_data[banks_data$duration > 2250 & banks_data$duration <= 2500 & banks_data$y == "yes",]
menor_2750 = banks_data[banks_data$duration > 2500 & banks_data$duration <= 2750 & banks_data$y == "yes",]
menor_3000 = banks_data[banks_data$duration > 2750 & banks_data$duration <= 3000 & banks_data$y == "yes",]
menor_3250 = banks_data[banks_data$duration > 3000 & banks_data$duration <= 3250 & banks_data$y == "yes",]
menor_3500 = banks_data[banks_data$duration > 3250 & banks_data$duration <= 3500 & banks_data$y == "yes",]
menor_3750 = banks_data[banks_data$duration > 3500 & banks_data$duration <= 3750 & banks_data$y == "yes",]
menor_250 = nrow(menor_250)
menor_500 = nrow(menor_500)
menor_750 = nrow(menor_750)
menor_1000 = nrow(menor_1000)
menor_1250 = nrow(menor_1250)
menor_1500 = nrow(menor_1500)
menor_1750 = nrow(menor_1750)
menor_2000 = nrow(menor_2000)
menor_2250 = nrow(menor_2250)
menor_2500 = nrow(menor_2500)
menor_2750 = nrow(menor_2750)
menor_3000 = nrow(menor_3000)
menor_3250 = nrow(menor_3250)
menor_3500 = nrow(menor_3500)
menor_3750 = nrow(menor_3750)
rango <- c("0-250", "250-500", "500-750", "750-1000", "1000-1250", "1250-1500", "1500-1750", "1750-2000", "2000-2250", "2250-2500", "2500-2750", "2750-3000", "3000-3250", "3250-3500", "3500-3750")
number_of_yes_rango <- c(menor_250, menor_500, menor_750, menor_1000, menor_1250, menor_1500,
menor_1750, menor_2000, menor_2250, menor_2500, menor_2750, menor_3000,
menor_3250, menor_3500, menor_3750)
data_duration_sus <- data.frame(duración = rango, number_of_yes = number_of_yes_rango)
data_duration_sus$duración <- factor(data_duration_sus$duración, levels = rango)
fig <- plot_ly(data_duration_sus, x = ~duración, y = ~number_of_yes, type = 'bar',
marker = list(color = 'orange'))
fig <- fig %>%
layout(title = "Número de subscripciones aceptadas según duración de las llamadas",
xaxis = list(title = "Duración de llamada en segundos"),
yaxis = list(title = "Número de subscripciones aceptadas"),
margin = list(b = 100)) # Espacio adicional para etiquetas inclinadas
fig
Descripción del grafico 2º
El gráfico anterior muestra la duración de las llamadas en intervalos de 250 segundos y el número de suscripciones aceptadas en esos períodos de tiempo. Se observa, por ejemplo, que las llamadas con una duración de entre 250 y 500 segundos tuvieron una mayor aceptación de suscripciones, y a partir de ahí, las suscripciones aceptadas disminuyen gradualmente mientras las llamadas se hacen más largas.
menor_17 = banks_data[banks_data$age <= 17 & banks_data$y=="yes",]
menor_27 = banks_data[banks_data$age > 17 & banks_data$age <= 27 & banks_data$y == "yes",]
menor_37 = banks_data[banks_data$age > 27 & banks_data$age <= 37 & banks_data$y == "yes",]
menor_47 = banks_data[banks_data$age > 37 & banks_data$age <= 47 & banks_data$y == "yes",]
menor_57 = banks_data[banks_data$age > 47 & banks_data$age <= 57 & banks_data$y == "yes",]
menor_67 = banks_data[banks_data$age > 57 & banks_data$age <= 67 & banks_data$y == "yes",]
menor_77 = banks_data[banks_data$age > 67 & banks_data$age <= 77 & banks_data$y == "yes",]
menor_87 = banks_data[banks_data$age > 77 & banks_data$age <= 87 & banks_data$y == "yes",]
menor_97 = banks_data[banks_data$age > 87 & banks_data$age <= 97 & banks_data$y == "yes",]
menor_17 = nrow(menor_17)
menor_27 = nrow(menor_27)
menor_37 = nrow(menor_37)
menor_47 = nrow(menor_47)
menor_57 = nrow(menor_57)
menor_67 = nrow(menor_67)
menor_77 = nrow(menor_77)
menor_87 = nrow(menor_87)
menor_97 = nrow(menor_97)
rango_ed <- c("0-17", "17-27", "27-37", "37-47", "47-57", "57-67", "67-77", "77-87",
"87-97")
number_of_yes_edad <- c(menor_17, menor_27, menor_37, menor_47, menor_57, menor_67,
menor_77, menor_87, menor_97)
data_edad_sus <- data.frame(edad = rango_ed, number_of_yes = number_of_yes_edad)
# Crear el gráfico de barras con plotly
fig <- plot_ly(data_edad_sus, x = ~edad, y = ~number_of_yes, type = 'bar',
marker = list(color = 'gold'))
fig <- fig %>%
layout(title = "Número de subs aceptadas según rangos de edades",
xaxis = list(title = "Rango de edades", tickangle = -45),
yaxis = list(title = "Número de suscripciones aceptadas"),
margin = list(b = 100))
fig
Descripción del grafico 2º
El gráfico muestra los rangos de edades en intervalos de 10 años frente a las cantidades de suscripciones aceptadas en esos rangos. Se observa que las personas entre 27 y 37 años fueron las que más suscripciones aceptaron con mucha diferencia por ejemplo.
jobs <- banks_data[,2]
data_jobs_age <- data.frame(trabajo = jobs, edad = age)
fig <- plot_ly(data_jobs_age, x = ~trabajo, y = ~age, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia de Edades por trabajo",
xaxis = list(title = "Empleo", tickangle = -45),
yaxis = list(title = "Edad"),
margin = list(b = 100))
fig
Descripción del gráfico de cajas
Estos gráficos de cajas son una excelente herramienta para visualizar la simetría de los datos. Este gráfico muestra la concentración de personas con ciertas profesiones según las edades que tienen. Por ejemplo, en el caso de los administradores, se puede observar que la mayoría de las personas que ejercen esta profesión están concentradas entre las edades de 36 y 44 años. Además, se destacan pocos casos, o más bien casos atípicos, en los que las personas con dicha profesión tienen una edad superior a los 64 años y este análisis de ejemplo se puede efectuar en cada profesión.
jobs <- banks_data[,2]
admin_edad = data_jobs_age[data_jobs_age$trabajo == "admin.",]
fig <- plot_ly(admin_edad, x = ~edad, y = ~trabajo, type = 'histogram',
marker = list(color = 'lightgreen'))
fig <- fig %>%
layout(
title = "Frecuencia de las edades de los administradores",
xaxis = list(title = "Edad", tickangle = -45),
yaxis = list(
title = "Cantidad de administradores",
tickvals = seq(0, 1200, by = 100)
),
margin = list(b = 100)
)
fig
Descripción del gráfico Histograma
Con este tipo de gráficos, se puede obtener una visión más detallada de la concentración de los datos. En este caso, se observa la distribución de las edades de las personas con la profesión de administrador, revelando que la mayoría de los administradores tienen entre 30 y 40 años teniendo un peak en los 33 años. Al igual que en los diagramas de cajas, este gráfico permite visualizar fácilmente la simetría de los datos.
# Crear un vector de colores para cada punto
num_points <- nrow(banks_data) # Número de puntos en los datos
my_colors <- sample(c('#a6cee3', '#1f78b4', '#b2df8a', '#33a02c', '#fb9a99',
'#e31a1c', '#fdbf6f', '#ff7f00', '#cab2d6', '#6a3d9a',
'#ffff99', '#b15928'), num_points, replace = TRUE)
fig <- plot_ly(data=banks_data,x=~age,y=~cons.conf.idx,frame=~job,
type="scatter", mode="markers",
marker = list(color = my_colors, # Asignar colores personalizados
size = 5), # Tamaño de los puntos
width=600, height=600,
symbol=I("circle-dot"),
showlegend=FALSE)
fig <- fig %>%
layout(
title = "Confianza según edad por cada trabajo",
xaxis = list(title = "Edad"),
yaxis = list(
title = "Índice Confianza")
)
fig
Con el gráfico de puntos, o dispersión, podemos ver la dispersión de una gran cantidad de datos. Con esté gráfico, podemos ver que no existe mucha diferencia en el índice de confianza según la edad. Peró, al comparar según los trabajos, vemos que los empleos con mayor cantidad de gente en un índice de confianza son los technician y los retired, que trabajarían como técnicos y ya retirados.
vino_blanco_data <- read.csv2("winequality-white.csv")
vino_blanco_data <- vino_blanco_data %>%
mutate(
fixed.acidity = as.numeric(fixed.acidity),
volatile.acidity = as.numeric(volatile.acidity),
citric.acid = as.numeric(citric.acid),
residual.sugar = as.numeric(residual.sugar),
chlorides = as.numeric(chlorides),
free.sulfur.dioxide = as.numeric(free.sulfur.dioxide),
total.sulfur.dioxide = as.numeric(total.sulfur.dioxide),
density = as.numeric(density),
pH = as.numeric(pH),
sulphates = as.numeric(sulphates),
alcohol = as.numeric(alcohol),
quality = as.factor(quality))
fixed.acidity <-(vino_blanco_data[,1]) # vector con las acidad fija
volatile.acidity <-(vino_blanco_data[,2]) # acidad volatil
citric.acid <- (vino_blanco_data[,3]) # acidad citrica
residual.sugar <- (vino_blanco_data[,4]) # azúcar residual
chlorides <- (vino_blanco_data[,5]) # cloruro
free.sulfur.dioxide <-(vino_blanco_data[,6]) # dioxido de sulfuro libre
total.sulfur.dioxide <- (vino_blanco_data[,7]) # dioxido de sulfuro total
density.vino <- (vino_blanco_data[,8]) # densidad del vino
ph <- (vino_blanco_data[,9]) # ph del vino
sulphates <- (vino_blanco_data[,10]) #creo que se refiere a sulphites o sulfitos que preservan a los vinos, porque sulphates se utiliza para la espuma de shampo y jabón
alcohol <- (vino_blanco_data[,11]) #grado de alcohol, del vino
quality <- (vino_blanco_data[,12]) #calidad del vino
vino_blanco_data_frame <- data.frame(fixed.acidity, volatile.acidity, citric.acid, residual.sugar, chlorides, free.sulfur.dioxide, total.sulfur.dioxide, density.vino, ph, sulphates, alcohol, quality)
metricas = describe(vino_blanco_data_frame,IQR=T,quant=c(.25,.50,.75)) #Cálculo e métricas
datatable(
metricas,
options = list(pageLength = 10),
caption = "Tabla descriptiva del vino blanco"
)
tabla_descriptiva_2 <- data.frame("Variables" = c(
"fixed.acidity",
"volatile.acidity",
"citric.acid",
"residual.sugar",
"chlorides",
"free.sulfur.dioxide",
"total.sulfur.dioxide",
"density.vino",
"ph",
"sulphates",
"alcohol",
"quality"),
"Descripción" = c(
"Concentración Acides fija",
"Concentración acides volatil",
"Concentración acides citrica",
"Azúcar residual",
"Concentración de cloruro",
"Dioxido de sulfuro libre",
"Dioxido de sulfuro total",
"Densidad del vino",
"pH del vino",
"Sulfitos que preservan a los vinos",
"Grado de alcohol del vino ",
"calidad del vino"
),
"Tipo de variable" = c(
"Cuantitativa",
"Cuantitativa",
"Cuantitativa",
"Cuantitativa",
"Cuantitativa",
"Cuantitativa",
"Cuantitativa",
"Cuantitativa",
"Cuantitativa",
"Cuantitativa",
"Cuantitativa",
"Cualitativa"))
tabla2 <- kable(tabla_descriptiva_2,
caption = "Tabla 2.- Tabla descriptiva") %>%
kable_styling(full_width = F) %>%
column_spec(1, bold = T, border_right = T)
tabla2
| Variables | Descripción | Tipo.de.variable |
|---|---|---|
| fixed.acidity | Concentración Acides fija | Cuantitativa |
| volatile.acidity | Concentración acides volatil | Cuantitativa |
| citric.acid | Concentración acides citrica | Cuantitativa |
| residual.sugar | Azúcar residual | Cuantitativa |
| chlorides | Concentración de cloruro | Cuantitativa |
| free.sulfur.dioxide | Dioxido de sulfuro libre | Cuantitativa |
| total.sulfur.dioxide | Dioxido de sulfuro total | Cuantitativa |
| density.vino | Densidad del vino | Cuantitativa |
| ph | pH del vino | Cuantitativa |
| sulphates | Sulfitos que preservan a los vinos | Cuantitativa |
| alcohol | Grado de alcohol del vino | Cuantitativa |
| quality | calidad del vino | Cualitativa |
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~fixed.acidity, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia de la acidez fija por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "Acides", tickvals = seq(3.8, 14.2, by = 0.8)),
margin = list(b = 100))
fig
cat("Media: ", mean(fixed.acidity))
## Media: 6.854788
cat("\nMediana: ",median(fixed.acidity))
##
## Mediana: 6.8
cat("\nModa: ",mfv(fixed.acidity))
##
## Moda: 6.8
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~volatile.acidity, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia de la acidez volátil por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "Acides", tickvals = seq(min(vino_blanco_data$volatile.acidity), max(vino_blanco_data$volatile.acidity), by = 0.1)),
margin = list(b = 100))
fig
cat("Media: ",mean(volatile.acidity))
## Media: 0.2782411
cat("\nMediana: ",median(volatile.acidity))
##
## Mediana: 0.26
cat("\nModa: ",mfv(volatile.acidity))
##
## Moda: 0.28
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~citric.acid, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia de la acidez cítrica por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "Acides", tickvals = seq(min(vino_blanco_data$citric.acid), max(vino_blanco_data$citric.acid), by = 0.1)),
margin = list(b = 100))
fig
cat("Media: ",mean(citric.acid))
## Media: 0.3341915
cat("\nMediana: ",median(citric.acid))
##
## Mediana: 0.32
cat("\nModa: ",mfv(citric.acid))
##
## Moda: 0.3
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~residual.sugar, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia del azúcar residual por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "Azúcar residual", tickvals = seq(min(vino_blanco_data$residual.sugar), max(vino_blanco_data$residual.sugar), by = 5)),
margin = list(b = 100))
fig
cat("Media: ",mean(residual.sugar))
## Media: 6.391415
cat("\nMediana: ",median(residual.sugar))
##
## Mediana: 5.2
cat("\nModa: ",mfv(residual.sugar))
##
## Moda: 1.2
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~chlorides, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia del cloruro por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "Cloruro", tickvals = seq(min(vino_blanco_data$chlorides), max(vino_blanco_data$chlorides), by = 0.02)),
margin = list(b = 100))
fig
cat("Media: ",mean(chlorides))
## Media: 0.04577236
cat("\nMediana: ",median(chlorides))
##
## Mediana: 0.043
cat("\nModa: ",mfv(chlorides))
##
## Moda: 0.044
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~free.sulfur.dioxide, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia de dioxido de sulfuro libre por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "Dioxido de sulfuro libre", tickvals = seq(min(vino_blanco_data$free.sulfur.dioxide), max(vino_blanco_data$free.sulfur.dioxide), by = 17)),
margin = list(b = 100))
fig
cat("Media: ",mean(free.sulfur.dioxide))
## Media: 35.30808
cat("\nMediana: ",median(free.sulfur.dioxide))
##
## Mediana: 34
cat("\nModa: ",mfv(free.sulfur.dioxide))
##
## Moda: 29
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~total.sulfur.dioxide, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia de dioxido de sulfuro total por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "Dioxido de sulfuro total", tickvals = seq(min(vino_blanco_data$total.sulfur.dioxide), max(vino_blanco_data$total.sulfur.dioxide), by = 42.5)),
margin = list(b = 100))
fig
cat("Media: ",mean(total.sulfur.dioxide))
## Media: 138.3607
cat("\nMediana: ",median(total.sulfur.dioxide))
##
## Mediana: 134
cat("\nModa: ",mfv(total.sulfur.dioxide))
##
## Moda: 111
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~density.vino, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia de la densidad por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "Densidad", tickvals = seq(min(vino_blanco_data$density), max(vino_blanco_data$density), by = 0.003)),
margin = list(b = 100))
fig
cat("Media: ",mean(density.vino))
## Media: 0.9940274
cat("\nMediana: ",median(density.vino))
##
## Mediana: 0.99374
cat("\nModa: ",mfv(density.vino))
##
## Moda: 0.992
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~pH, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia del pHs únicos por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "pH", tickvals = seq(min(vino_blanco_data$pH), max(vino_blanco_data$pH), by = 0.15)),
margin = list(b = 100))
fig
cat("Media: ",mean(ph))
## Media: 3.188267
cat("\nMediana: ",median(ph))
##
## Mediana: 3.18
cat("\nModa: ",mfv(ph))
##
## Moda: 3.14
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~sulphates, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia de los niveles de sulfatos por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "Sulfatos", tickvals = seq(min(vino_blanco_data$sulphates), max(vino_blanco_data$sulphates), by = 0.11)),
margin = list(b = 100))
fig
cat("Media: ",mean(sulphates))
## Media: 0.4898469
cat("\nMediana: ",median(sulphates))
##
## Mediana: 0.47
cat("\nModa: ",mfv(sulphates))
##
## Moda: 0.5
fig <- plot_ly(vino_blanco_data, x = ~quality, y = ~alcohol, type = 'box',
marker = list(color = 'purple'))
fig <- fig %>%
layout(title = "Frecuencia de los grados de alcohol por calidad de vino",
xaxis = list(title = "Niveles de calidad"),
yaxis = list(title = "Alcohol", tickvals = seq(min(vino_blanco_data$alcohol), max(vino_blanco_data$alcohol), by = 1.2)),
margin = list(b = 100))
fig
cat("Media: ",mean(alcohol))
## Media: 10.51427
cat("\nMediana: ",median(alcohol))
##
## Mediana: 10.4
cat("\nModa: ",mfv(alcohol))
##
## Moda: 9.4
Para los gráficos anteriores se tomó la variable “quality” como una variable cualitativa-categórica (factor) debido a que se dividía en 6 niveles de calidad del 3 al 9. Teniendo esto en cuenta, se realizaron gráficos de cajas para un análisis descriptivo.
Considerando las simetrías de los datos en cada gráfico, no existe una gran diferencia entre los componentes del vino blanco para los diferentes niveles. Se puede observar que las concentraciones de los datos en cada gráfico por nivel de calidad del vino son muy similares. Por ejemplo:
En el gráfico 1, se puede ver que la frecuencia de acidez fija en cada vino es parecida. Analizando, por ejemplo, el cuartil 3, la mayoría de los datos están concentrados en los valores 6.8 y 7.8 de acidez fija. Los vinos de nivel 3 presentan una mayor variedad en este aspecto. Además, lo anterior se refleja de una manera muy similar (en cuanto a la simetría de los datos) en el gráfico 2.
En el gráfico 3, la acidez cítrica de los diferentes niveles de vino es aún más parecida. Se observan concentraciones y simetrías de datos bastante similares, con valores centrales (cuartil 50) muy parecidos entre sí, promediando 0.3248571 (con un coeficiente de variación del 7.53%).
datos <- c(0.354, 0.29, 0.32, 0.32, 0.31, 0.32, 0.36)
media <- mean(datos)
desviacion_estandar <- sd(datos)
cv <- (desviacion_estandar / media) * 100
cat("Media:", media, "\n")
## Media: 0.3248571
cat("Desviación estándar:", desviacion_estandar, "\n")
## Desviación estándar: 0.02446377
cat("Coeficiente de variación de los valores centrales gráfico 3:", cv, "%\n")
## Coeficiente de variación de los valores centrales gráfico 3: 7.530625 %
Cada gráfico muestra una simetría de datos muy parecida dentro de rangos muy similares. Sin embargo, se encuentra una mayor diferencia en el gráfico número 5 con el vino de nivel 9, donde la concentración de los datos está por debajo de todos los cuartiles 1 de cada diagrama de caja asociado a cada nivel. Esto sugiere que los vinos del nivel 9 tienen una gran diferencia en la cantidad de cloruro con respecto a los otros niveles.